Whiteline: Alpha/Whiteline Alpha.iso/progtool/forth/tasker.scr

Text File | 1994-09-22 | 8.0 KB | 1 lines

\\                    *** Multitasker ***             bp 12oct86                                                                Dieses File enthält die Worte für das Multitasking.                                                                             Mit  TASK  werden Tasks eingerichtet. Jede Task hat ihren eige-  nen Daten- und Returnstack, deren Größe beim Einrichten der     Task angegeben werden muß.                                                                                                     Mit  MULTITASK  wird der Tasker eingeschaltet, mit  SINGLETASK   abgeschaltet. Mit  TASKS  kann man die Tasks im System und      ihren Zustand anzeigen.                                                                                                        Näheres zur Funktionsweise des Taskers findet man im Handbuch,   ebenso wie ein ausführliches Glossar !                                                                                                                                                         \ Multitasker Loadscreen                               22nov86bp                                                                Onlyforth                                                                                                                       \needs Code        2 loadfrom assemble.scr                      \needs multitask   1 +load                                                                                                      02 05 +thru    \ Tasker                                            06 +load    \ Spooler                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ stop singletask multitask                            14sep86we                                                                Code stop                                                         .l FP IP suba   .w IP SP -) move                                .l FP RP suba   .w RP SP -) move                                   UP R#) D6 move   D6 reg) A0 lea                              .l FP SP suba   .w SP 8 A0 D) move                                 2 A0 D) D6 move  D6 reg) jmp  end-code                                                                                     Label taskpause                                                     UP R#) D6 move   D6 reg) A0 lea   $4E43 # A0 ) move             Forth ' stop @ Assembler bra  end-code                                                                                      : singletask   [ ' pause @ ] Literal  ['] pause ! ;                                                                             : multitask    taskpause  ['] pause ! ;                         \ pass activate                                       bp 12oct86                                                                | : (pass   ( n0 ... nm-1 Taskaddr m -- )                          rdrop  swap            \ delete IP of ACTIVATE or PASS          $4E43 over !           \ awake Task                             r> -rot                \ get the IP;  Stack: IP m Taskaddr      &10 + >r               \ push s0 of Task                        r@ 2+ @ swap           \ Stack-Top:  IP r0 m                    2+ 2*                  \ bytes on Taskstack incl. r0 & IP       r@ @ over -            \ new SP                                 dup r> 2- !            \ into Ssave                             swap bounds  ?DO  I !  2 +LOOP  ;                                                                                            : activate   ( Taddr -- )               0 (pass ;  restrict                                                                     : pass       ( n0 ... nm-1 Taskaddr m )   (pass ;  restrict     \ sleep wake taskerror                                bp 12oct86                                                                : sleep   ( Taddr -- )    $3C3C swap ! ; \ # D6 move opcode     : wake    ( Taddr -- )    $4E43 swap ! ; \ Trap 3 opcode                                                                        | : taskerror   ( string -- )                                        standardi/o  singletask  bell                                   at?  &24 0 at  ." Task error : "  rot count type   at           multitask stop ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           \ Task                                                 14sep86we                                                                : Task   ( rlen slen -- )                                          2 arguments                                                     0 Constant  here >r               \ Task-dp                     even dup  r@ +  r@ 2- !  allot  even  \ 68000 align             up@ here 100 cmove               \ init user area               here   $3C3C , up@ 2+ @ ,        \ JMP opcode to sleep task     $4EF3 , $6800 ,                                                 dup  up@ 2+ !                    \ link task                    dup  6 -   dup , ,               \ ssave and s0                 2dup + ,                         \ here + rlen = r0             r@ ,                             \ dp                           under  + here - allot  0 ,                                      ['] taskerror  swap  [ ' errorhandler >body c@ ] Literal + !    r> 2- 2- , ;                                                 \ rendezvous 's tasks                                  22nov86bp                                                                : rendezvous   ( semaphoraddr -- )                                 dup unlock  pause  lock ;                                                                                                    | : statesmart       state @ IF  [compile] Literal  THEN ;                                                                      : 's   ( Taddr -- adr )     \ adr is adress of the foll. uservar   ' >body c@ +  statesmart ;  immediate                                                                                        : tasks   ( -- )                                                   cr  ." Main "    up@ dup 2+ @                                   BEGIN  2dup -  WHILE cr dup  [ ' r0 >body c@ ] Literal  +  @                         2+ @ >name .name                                                dup @  $3C3C = IF  ." sleeping"  THEN              2+  @  REPEAT  2drop ;                               \ Printerspool                                         21oct86we                                                                $100 $200 Task spooler                                                                                                          : spool'  ( -- )   \ reads word                                    '  isfile@  offset @  base @   spooler  depth 1-  6 min  pass   base !  offset !  isfile !  execute                             true abort" SPOOL' ready for next job!" stop ;                                                                               \\ syntax:                                                      spool' listing                                                  spool' printall                                                 from to spool' pthru                                            from to spool' document